/*
    REDLISP - interpreter/compiler for new dialect of LISP called REDLISP
    Copyright (C) 2006  Rudolf Olah

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*/

#include "eval_parser.h"

dList *
parse (string line)
{
  if (line.empty ())
    return 0;
  // Make sure the statement isn't empty
  if (line[0] == '(' && line[1] == ')')
    return new dList ();
  // Erase whitespace, before and after statement
  line.erase (0, line.find_first_not_of (" "));
  line.erase (line.find_last_of (')'), line.length ());
  // Erase bracket
  if (line[0] == '(')
    line.erase (0, 1);
  else if (line[0] == '\'' && line[1] == '(')
    {
      line.erase (0, 2);
      line.insert (0, "quote (");
    }
  return parse (tokenize (chop (line), ' '));
}

dList *
parse (dList *line)
{
  if (line == 0)
    return new dList ();
  #ifdef DEBUG
  printf ("::entering parse\n");
  #endif

  dList *exp = new dList ();
  string item;
  string expString;
  expString.reserve (64);

  bool subExpression = false;
  bool inString = false;
  int bracketCount = 0;

  for (int i = 0; i < line->size; i++)
   {
     item = ((dString*)(*line)[i])->value;
     if (item.empty () || (item == " " && !inString))
       continue;
     if (item[0] == '\"' && !subExpression)
       {
	 item.erase (0, 1);
	 if (inString)
	   {
	     exp->append (new dString (expString));
	     inString = false;
	     expString = "";
	   }
	 else
	   inString = true;
       }
     if (inString)
       {
	 expString += item;
	 expString += " ";
	 if (item[item.length ()-1] == '\"')
	   {
	     expString.erase (expString.end ()-2, expString.end ());
	     #ifdef DEBUG
	     cout << "expString::" << expString << endl;
	     #endif
	     exp->append (new dString (expString));
	     inString = false;
	     expString = "";
	   }
	 continue;
       }
     if (item[0] == '(' || (item[0] == '\'' && item[1] == '('))
       {
	 subExpression = true;
	 bracketCount++;
       }
     if (item[0] == ')' || (item[item.length ()-1] == ')' && !inString))
       bracketCount -= (item.length () - item.find (')'));
     #ifdef DEBUG
     printf ("Bracket Count: %i\n", bracketCount);
     #endif
     if (subExpression)
       {
	 if (bracketCount > 0)
	   {
	     expString += item;
	     expString += " ";
	   }
	 else
	   {
	     expString += item;
	     #ifdef DEBUG
	     cout << "expString::" << expString << endl;
	     #endif
	     exp->append (parse (expString));
	     expString = "";
	     subExpression = false;
	   }
       }
     else
       {
	 if (isInt (chop (item)))
	   exp->append (new dNumber (
#ifdef BIGNUM
				     mpz_class (item)
#else
				     (int)strtol (item.c_str (),
						  (char**)NULL, 10)
#endif
				     ));
	 else if (isDec (chop (item)))
	   exp->append (new dNumber (
#ifdef BIGNUM
				     mpf_class (item)
#else
				     strtod (item.c_str (), (char**)NULL)
#endif
				     ));
	 else if (isRational (chop (item)))
	   exp->append (new dNumber (
#ifdef BIGNUM
				     mpq_class (item)
#else
				     item
#endif
				     ));
	 else if (!item.empty ())
	   exp->append (new dSymbol (item));
       }
   }
  #ifdef DEBUG
  printf ("%s\n", exp->toString ().c_str ());
  printf ("::exiting parse\n");
  #endif
  return exp;
}

dObject *
eval (string exp, dList *environment, dList *env2)
{
  int count;
  // Make sure the quotation count is correct
  if ((charcount (exp, '\"') % 2) > 0)
    return new dError ("Invalid expression: double-quote count is off. Make sure all double-quotes are paired up.");

  count = charcount (exp, '(');
  // Make sure the bracket count is correct
  if (count != charcount (exp, ')'))
    return new dError ("Invalid expression: bracket count is off. Make sure all brackets are paired up.");
  else if (count == 0) // If there are no brackets, return the value
		       // of the symbol
    return get_variable (new dSymbol (exp), environment, env2);

  // Erase whitespace, before and after statement
  exp.erase (0, exp.find_first_not_of (' '));
  exp.erase (exp.find_last_of (')')+1, exp.length ());
  
  // Make sure the statement isn't empty
  if (exp[0] == '(' && exp[1] == ')')
    return new dError ("Invalid expression: empty.");
  return eval (parse (exp), environment, env2);
}

dObject *
eval (dList *expList, dList *environment, dList *env2)
{
  dNode *current = 0;
  dObject *item = 0;
  dList *argumentList = 0;

  #ifdef DEBUG
  cout << ":: entering eval\n";
  debug (expList);
  #endif

  dCompiled *functionPointer = 0;
  dLambda *lambdaPointer = 0;
  if (expList != 0 && expList != nil)
    {
      current = expList->first;
      if (current != 0)
	{
	  item = current->car;
	  //cout << "Non-empty expression dList\n";
	  #ifdef DEBUG
	  debug (item);
	  #endif
	  if (item->type == 'S') // If the first item is a symbol...
	    {
	      dSymbol *temp = (dSymbol*)item;
	      if ((*temp) == "function")
		return dMakeLambda (expList);
	      else if ((*temp) == "if")
		return dIfCall (expList, environment, env2);
	      else if ((*temp) == "while")
		{
		  
		}
	      else if (temp->name[0] == '\'') // Variable assignments with '
		{
		  //console->WriteLine ("Quoted variable assignment");
		  argumentList = new dList ();
		  temp->name.erase (0, 1);
		  argumentList->append (new dString ("quote"));
		  argumentList->append ((*expList)[1]);
		  item = eval (argumentList, environment, env2);
		  return add_variable (temp,
				       item,
				       environment);
		}
	      else if ((*temp) == "let") // Variable assignments with let
		{
		  //console->WriteLine ("Let variable assignment");
		  argumentList = new dList ();
		  argumentList->append (new dString ("quote"));
		  argumentList->append ((*expList)[2]);
		  item = eval (argumentList, environment, env2);
		  return add_variable ((dSymbol*)(*expList)[1],
				       item,
				       environment);
		}
	    }
	  else if (item->type == 'l') // If the first item is a list...
	    {
	      //printf ("item-list::%s\n", item->toString ().c_str ());
	      item = eval ((dList*)item, environment, env2);
	      if (item->type == 'f')
		{
		  if (item->typeStr == "COMPILED")
		    functionPointer = (dCompiled*)item;
		  else if (item->typeStr == "LAMBDA")
		    lambdaPointer = (dLambda*)item;
		  //else if (item->typeStr == "MACRO")
		  //  macroPointer = (dMacro*)item;
		}
	    }
	  if (functionPointer == 0 && lambdaPointer == 0)
	    {
	      dObject *temp_object = get_variable ((dSymbol*)item, environment, env2);
	      if (temp_object->type == 'f')
		{
		  if (temp_object->typeStr == "COMPILED")
		    functionPointer = (dCompiled*)temp_object;
		  else if (temp_object->typeStr == "LAMBDA")
		    lambdaPointer = (dLambda*)temp_object;
		  //else if (temp_object->typeStr == "MACRO")
		  //  macroPointer = (dMacro*)temp_object;
		}
	      else
		return new dError ("No such symbol exists");
	    }
	  else
	    return item;
	    //return new dError ("First item in an s-expression is always a function or macro (either a list that returns one of those two or a symbol that can be found in *system*)");
	  delete item;
	  current = current->cdr;
	}
    }
  else
    return nil;

  if (current != 0)
    {
      argumentList = new dList ();
      while (current != 0)
	{
	  item = current->car;
	  if (item->type == 'l' && ((dList*)item)->first != 0)
	    {
	      dObject *first_data = ((dList*)item)->first->car;
	      if (first_data->toString () == "quote")
		item = (dList*)((dList*)item)->last->car;
	      else
		item = eval ((dList*)item, environment, env2);
	    }
	  if (item->type == 'S')
	    {
	      if (item->toString ()[0] != '\'')
		item = get_variable ((dSymbol*)item, environment, env2);
	      else
		((dSymbol*)item)->name.erase (0,1);
	    }
	  if (item->type == 'e')
	    return new dError (string("Argument returned an error; cannot continue eval'ing\n") + item->toString (),
			       "sym.name", argumentList);
	  argumentList->append (item);
	  current = current->cdr;
	}
    }

  if (functionPointer != 0)
    return functionPointer->exec (argumentList);
  else if (lambdaPointer != 0)
    return lambdaPointer->exec (argumentList, system_environment);

  if (argumentList != 0)
    delete argumentList;
  if (expList != 0)
    delete expList;
  return new dString ("");
}




dObject *
add_variable (string key, dObject *data, dList *environment)
{
  return add_variable (new dSymbol (key), data, environment);
}

dObject *
add_variable (dSymbol *key, dObject *data, dList *environment)
{
  if (environment == 0)
    return new dError ("No environment present");
  if (key == 0)
    return new dError ("No symbol present");
  if (data == 0)
    return new dError ("No data present");
  else
    {
      environment->insert (create_pair (key, data));
      return data;
    }
  return new dError ("error in add_variable");
}

dObject *
get_variable (dSymbol *var, dList *env1, dList *env2)
{
  if (env1 == 0)
    return new dError ("No environment given");
  if (var == 0)
    return new dError ("No symbol given");
  dNode *current = env1->first;
  dNode *item = 0;
  while (current != 0 && current->car != 0)
    {
      item = ((dList*)current->car)->first;
      if (item->car != 0 && item->cdr != 0)
	if (*(dSymbol*)(item->car) == *var)
	  return item->cdr->car;
      current = current->cdr;
    }
  if (env2 != 0)
    return get_variable (var, env2);
  return new dError ("Symbol `" + var->name + "' does not exist");
}

dObject *
delete_variable (dSymbol *var, dList *environment)
{
  if (environment == 0)
    return new dError ("No environment present");
  if (var == 0)
    return new dError ("No symbol given");
  return new dString ("");
}

dObject *
process (dObject *item, dList *env1, dList *env2)
{
  dObject *temp = item;
  if (item->type == 'l' && ((dList*)item)->size > 0)
    temp = eval ((dList*)item, env1, env2);
  if (temp->type == 'S')
    temp = get_variable ((dSymbol*)temp, env1, env2);
  return temp;
}
